home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SORT_UTL / SORTS17 / QSORT.PAS < prev   
Pascal/Delphi Source File  |  1993-03-09  |  2KB  |  70 lines
  1. {************************************************}
  2. {                                                }
  3. { QuickSort Demo                                 }
  4. { Copyright (c) 1985,90 by Borland International }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program QSort;
  9. {$R-,S-}
  10. uses Crt;
  11.  
  12. { This program demonstrates the quicksort algorithm, which      }
  13. { provides an extremely efficient method of sorting arrays in   }
  14. { memory. The program generates a list of 1000 random numbers   }
  15. { between 0 and 29999, and then sorts them using the QUICKSORT  }
  16. { procedure. Finally, the sorted list is output on the screen.  }
  17. { Note that stack and range checks are turned off (through the  }
  18. { compiler directive above) to optimize execution speed.        }
  19.  
  20. const
  21.   Max = 1000;
  22.  
  23. type
  24.   List = array[1..Max] of Integer;
  25.  
  26. var
  27.   Data: List;
  28.   I: Integer;
  29.  
  30. { QUICKSORT sorts elements in the array A with indices between  }
  31. { LO and HI (both inclusive). Note that the QUICKSORT proce-    }
  32. { dure provides only an "interface" to the program. The actual  }
  33. { processing takes place in the SORT procedure, which executes  }
  34. { itself recursively.                                           }
  35.  
  36. procedure QuickSort(var A: List; Lo, Hi: Integer);
  37.  
  38. procedure Sort(l, r: Integer);
  39. var
  40.   i, j, x, y: integer;
  41. begin
  42.   i := l; j := r; x := a[(l+r) DIV 2];
  43.   repeat
  44.     while a[i] < x do i := i + 1;
  45.     while x < a[j] do j := j - 1;
  46.     if i <= j then
  47.     begin
  48.       y := a[i]; a[i] := a[j]; a[j] := y;
  49.       i := i + 1; j := j - 1;
  50.     end;
  51.   until i > j;
  52.   if l < j then Sort(l, j);
  53.   if i < r then Sort(i, r);
  54. end;
  55.  
  56. begin {QuickSort};
  57.   Sort(Lo,Hi);
  58. end;
  59.  
  60. begin {QSort}
  61.   Write('Now generating 1000 random numbers...');
  62.   Randomize;
  63.   for i := 1 to Max do Data[i] := Random(30000);
  64.   Writeln;
  65.   Write('Now sorting random numbers...');
  66.   QuickSort(Data, 1, Max);
  67.   Writeln;
  68.   for i := 1 to 1000 do Write(Data[i]:8);
  69. end.
  70.